home *** CD-ROM | disk | FTP | other *** search
/ Info-Mac 4 / Info_Mac IV CD-ROM (Pacific HiTech Inc.)(August 1994).iso / Science / MAL ©P.f.Howden 1⁄1⁄89 / DIFFROOTS < prev    next >
Text File  |  1987-06-03  |  12KB  |  158 lines
  1. 1 CLS :DEFDBL F,C,H,X:PRINT"DIFFROOTS-boot with OLD BASIC to enable MERGE of problem equations." : PRINT "FOR ROOTS OF SINGLE EQU. USE LINE 10" : PRINT
  2. 2 PRINT "FOR SIMULTANEOUS EQUATIONS" : PRINT "ENTER YOUR EQUATIONS AS FOLLOWS:"
  3. 3 PRINT "10 F(0)=2*X(0)-3*X(1)-17: RETURN":PRINT"11 F(1)=X(0)+X(1)-1: RETURN":PRINT
  4. 4 PRINT "FOR DIFFERENTIAL EQUATIONS" : PRINT "ENTER EQUATIONS AS FOLLOWS: " : PRINT : PRINT "FOR 0TH ORDER:- START ON LINE 10": PRINT "FOR 1ST ORDER:- START ON LINE 11"
  5. 5 PRINT "FOR 2ND ORDER:- START ON LINE 12" : PRINT "FOR 3RD ORDER:- START ON LINE 13" : PRINT "FOR 4TH ORDER:- START ON LINE 14" : PRINT
  6. 6 PRINT "FOR SIM.DIFF. EQU. USE LINE STARTING" : PRINT "AT 10,20,30 & 40 FOR 1,2,3,4 SETS" : PRINT
  7. 7 PRINT "PRESS SPACE TO CONTINUE" : PRINT "OR <BREAK> TO ENTER EQUATIONS"
  8. 8 A$=INKEY$ : IF A$<>" " THEN GOTO 8
  9. 9 GOTO 100
  10. 10 F(0)=X(0)-(C(0)+C(1)*H*(1-B(3))+C(2)*H^2/2*(1-B(2))+C(3)*H^3/6*(1-B(1))+H*X(1)*B(3)+H^2/2*X(2)*B(2)+H^3/6*X(3)*B(1)+H^4/24*X(4)+H^5/120*X(5)) : RETURN
  11. 11 F(1)=X(1)-(C(1)+C(2)*H*(1-B(2))+C(3)*H^2/2*(1-B(1))+H*X(2)*B(2)+H^2/2*X(3)*B(1)+H^3/6*X(4)+H^4/24*X(5)) : RETURN
  12. 12 F(2)=X(2)-(C(2)+C(3)*H*(1-B(1))+H*X(3)*B(1)+H^2*X(4)/2+H^3*X(5)/6) : RETURN
  13. 13 F(3)=X(3)-(C(3)+H*X(4)+H^2*X(5)/2): RETURN
  14. 20 F(10)=X(10)-(C(10)+C(11)*H*(1-B(6))+C(12)*H^2/2*(1-B(5))+C(13)*H^3/6*(1-B(4))+H*X(11)*B(6)+H^2/2*X(12)*B(5)+H^3/6*X(13)*B(4)+H^4/24*X(14)+H^5/120*X(15)) : RETURN
  15. 21 F(11)=X(11)-(C(11)+C(12)*H*(1-B(5))+C(13)*H^2*(1-B(4))/2+H*X(12)*B(5)+H^2*X(13)*B(4)/2+H^3*X(14)/6+H^4*X(15)/24): RETURN
  16. 22 F(12)=X(12)-(C(12)+C(13)*H*(1-B(4))+H*X(13)*B(4)+H^2*X(14)/2+H^3*X(15)/6): RETURN
  17. 23 F(13)=X(13)-(C(13)+H*X(14)+H^2/2*X(15)) : RETURN
  18. 30 F(20)=X(20)-(C(20)+C(21)*H*(1-B(9))+C(22)*H^2/2*(1-B(8))+C(23)*H^3/6*(1-B(7))+H*X(21)*B(9)+H^2/2*X(22)*B(8)+H^3/6*X(23)*B(7)+H^4/24*X(24)+H^5/120*X(25)) : RETURN
  19. 31 F(21)=X(21)-(C(21)+C(22)*H*(1-B(8))+C(23)*H^2/2*(1-B(7))+H*X(22)*B(8)+H^2/2*X(23)*B(7)+H^3/6*X(24)+H^4/24*X(25)) : RETURN
  20. 32 F(22)=X(22)-(C(22)+C(23)*H*(1-B(7))+H*X(23)*B(7)+H^2/2*X(24)+H^3/6*X(25)) : RETURN
  21. 33 F(23)=X(23)-(C(23)+H*X(24)+H^2/2*X(25)) : RETURN
  22. 40 F(30)=X(30)-(C(30)+C(31)*H*(1-B(12))+C(32)*H^2/2*(1-B(11))+C(33)*H^3/6*(1-B(10))+H*X(31)*B(12)+H^2/2*X(32)*B(11)+H^3/6*X(33)*B(10)+H^4/24*X(34)+H^5/120*X(35)) : RETURN
  23. 41 F(31)=X(31)-(C(31)+C(32)*H*(1-B(11))+C(33)*H^2/2*(1-B(10))+H*X(32)*B(11)+H^2/2*X(33)*B(10)+H^3/6*X(34)+H^4/24*X(35)) : RETURN
  24. 42 F(32)=X(32)-(C(32)+C(33)*H*(1-B(10))+H*X(33)*B(10)+H^2/2*X(34)+H^3/6*X(35)) : RETURN
  25. 43 F(33)=X(33)-(C(33)+H*X(34)+H^2/2*X(35)) : RETURN
  26. 100 DEF FNS(X)=LOG(ABS(X)+SQR(X*X+1))
  27. 110 CLS : D1=0 : INPUT "DIFFERENTIAL EQUATIONS? (Y/N)" ; T$ : IF LEFT$(T$,1)="Y" THEN D1=1 : SS=1 : K1=0 : SS$=" " : C7=0 : C8=0 : UL=0 : DIM B(12),D0(9),N(9)
  28. 120 IF D1=1 THEN INPUT "SIMULTANEOUS? (Y/N)" ; T$ : IF LEFT$(T$,1)="Y" THEN INPUT "HOW MANY? (2/3/4)" ; SS : IF SS<2 OR SS>4 THEN GOTO 120
  29. 130 IF D1=1 THEN PRINT : FOR SI=1 TO SS : PRINT "DIFF ORDER IN SUB-SET" ; SI ; "? (0/1/2/3/4)" ; : INPUT D0(SI) : NEXT SI : GOSUB 700 : GOTO 145
  30. 140 INPUT "NR OF EQUATIONS" ; N : NN=N : N=N-1
  31. 145 INPUT "CONSTANTS? (Y/N)" ; T$ : IF LEFT$(T$,1)="Y" THEN INPUT "HOW MANY" ; G : DIM G(G) : FOR I=0 TO G-1 : PRINT "G(" ; I ; ")=" ; : INPUT G(I) : NEXT I
  32. 150 DIM A(NN) , A1(NN) , F(NN) , H(NN) ,P(NN) , R(NN) , R1(NN) , S(NN) , S1(NN) , S2(NN) , X(NN) ,X1(NN) , X2(NN)
  33. 155 INPUT "DECIM ACCUR=" ; D : INPUT "NR OF ITERATIONS=" ; M
  34. 160 IF D1=0 THEN GOTO 170
  35. 165 NN=NN-5 : FOR I=0 TO NN : S1(I)=1 : S(I)=-1 : X(I)=0 : X2(I)=X(I) : NEXT I : FOR I=0 TO N : A1(I)=AA(I) : A(I)=AA(I) : NEXT I : GOTO 220
  36. 170 FOR I=0 TO N : PRINT "X(" ; I ; ")=" ; : INPUT X(I) : X2(I)=X(I) : NEXT I
  37. 180 FOR I=0 TO N : PRINT "R(" ; I ; ")=" ; : INPUT R(I) : R1(I)=R(I) : NEXT I
  38. 190 FOR I=0 TO N : S1(I)=1 : P(I)=0 : A(I)=I : A1(I)=I : NEXT I
  39. 200 K1=0 : K2=0 : IF N=0 THEN INPUT "FINE SEARCH? (Y/N)" ; T$ : IF LEFT$(T$,1)="Y" THEN INPUT "SEARCH INCREMENT=" ; L : K1=1 : K2=1
  40. 210 IF N=0 THEN INPUT "SIGN F(0)=" ; S(0) : IF K1=1 THEN PRINT : PRINT " F(X)" ; TAB(26) ; "X" : PRINT : GOSUB 325 : GOTO 270
  41. 215 IF N=0 THEN GOSUB 320 : GOTO 270
  42. 220 INPUT "RE-ARRANGE EQUATIONS? (Y/N)" ; T$ : IF LEFT$(T$,1)="N" THEN GOTO 250
  43. 230 IF D1=1 THEN GOSUB 1000 : GOTO 260
  44. 240 PRINT "ENTER EQUATION SEQUENCE" : PRINT : PRINT "ORIGINAL F( ) " , "NEW SEQUENCE" : FOR I=0 TO N : PRINT I , : INPUT A(I) : NEXT I
  45. 250 IF D1=0 THEN INPUT "SIGN SEARCH? (Y/N)" ; SS$ : IF LEFT$(SS$,1)="Y" THEN GOSUB 600 : GOTO 240
  46. 260 IF D1=1 THEN GOSUB 1100 : GOSUB 300 : GOTO 280
  47. 270 FOR I=0 TO N : PRINT "SIGN F(" ; I ; ")=" ; : INPUT S(I) : NEXT I : FOR I2=0 TO N : I=A(I2) : X(I)=X2(I) : R(I)=R1(I2) : S1(I)=1 : P(I)=0 : NEXT I2 : GOSUB 300 : IF N=0 THEN GOTO 270
  48. 275 GOTO 220
  49. 280 FOR I2=0 TO N : I=A(I2) : X(I)=X2(I) : R(I)=R1(I2) : S1(I)=1 : P(I)=0 : NEXT I2 : GOSUB 800 : IF LEFT$(T$,1)="S" THEN GOSUB 1500 : GOTO 220
  50. 285 IF C7=0 THEN PRINT : IF LEFT$(T$,1)="C" THEN GOSUB 1600
  51. 290 GOSUB 300 : GOTO 280
  52. 300 PRINT : PRINT : PRINT "SIGN COMB." ; : IF D1=1 THEN GOSUB 1300 : GOTO 310
  53. 305 FOR I=0 TO N : PRINT TAB(4*I+12) ; S(I) ; : NEXT I : PRINT
  54. 310 PRINT : PRINT "EQU. SEQU." ; : IF D1=1 THEN GOSUB 1400 : GOTO 320
  55. 315 FOR I=0 TO N : PRINT TAB(4*I+12) ; A(I) ; : NEXT I : PRINT
  56. 320 PRINT : PRINT "ITER" ; TAB(11) ; "P" ; TAB(18) ; "R" ; TAB(28) ; "ROOT" : PRINT
  57. 325 FOR K=1 TO M : L1=-1
  58. 326 FOR I2=0 TO N
  59. 327 I=A(I2) : I1=A1(I2)
  60. 330 J=I+1 : ON J GOSUB 10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42,43,44,45
  61. 333 IF ABS(X(I1))>1000000! OR ABS(F(I))>1E+18 THEN PRINT "X OR F ABOVE LIMIT SET IN LINE 333" : K=M : Q=1 : GOTO 495
  62. 335 H(I)=S(I)*FNS(F(I))*SGN(F(I)) : S2(I)=SGN(H(I))
  63. 340 IF K1=1 THEN GOSUB 505 : IF K1=1 THEN GOSUB 10 : GOTO 335
  64. 345 IF S2(I)*S1(I)>0 THEN P(I)=P(I)+1 : R(I)=R(I)-1
  65. 400 R(I)=R(I)+1 : X1(I1)=X(I1)+H(I)*2^(P(I)/3-R(I)-1/3) : IF D1=1 THEN GOSUB 1200 : GOTO 410
  66. 405 PRINT TAB(2) ; K ; TAB(10) ; P(I) ; TAB(17) ; R(I) ; TAB(25) ; X1(I1)
  67. 410 IF ABS(X1(I1)-X(I1))<D THEN L1=L1+1
  68. 415 X(I1)=X1(I1) : S1(I)=S2(I)
  69. 416 NEXT I2
  70. 417 IF L1<>N THEN GOTO 485
  71. 420 PRINT : PRINT "SOLUTION" ; TAB(32) ; "RESIDUAL" : PRINT
  72. 425 FOR I3=0 TO N : I=A1(I3) : I1=A(I3) : IF D1=1 THEN GOTO 440
  73. 430 PRINT "X" ; I ; "=" ; X1(I) ; TAB(28) ; "F" ; I ; "=" ;
  74. 435 IF L1=N THEN J=I+1 : ON J GOSUB 10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42,43,44,45
  75. 436 PRINT TAB(35) ; F(I) : GOTO 445
  76. 440 FOR J0=1 TO KT : IF I<>ND(J0) THEN GOTO 444
  77. 441 PRINT "X" ; I ; "=" ; X1(I) ; TAB(28) ; "F" ; I ; "=" ;
  78. 442 IF L1=N THEN J=I+1 : ON J GOSUB 10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42,43,44,45
  79. 443 PRINT TAB(35) ; F(I) : GOTO 445
  80. 444 NEXT J0
  81. 445 NEXT I3
  82. 450 PRINT : PRINT "SIGN CONB." ; : IF D1=1 THEN GOSUB 1300 : GOTO 460
  83. 455 FOR I=0 TO N : PRINT TAB(4*I+12) ; S(I) ; : NEXT I
  84. 460 PRINT : PRINT "EQU. SEQU." ; : IF D1=1 THEN GOSUB 1400 : GOTO 470
  85. 465 FOR I=0 TO N : PRINT TAB(4*I+12) ; A(I) ; : NEXT I : PRINT : PRINT
  86. 470 IF D1=0 THEN INPUT "TO CONTINUE,PRESS RETURN";CC$:PRINT
  87. 475 IF D1=1 AND LEFT$(SS$,1)="Y" THEN GOSUB 800
  88. 480 PRINT : K=M : Q=0 : GOTO 495
  89. 485 A$=INKEY$ : IF A$<>"" THEN K=M : Q=1 : GOTO 495
  90. 490 Q=2
  91. 495 PRINT : NEXT K
  92. 496 IF Q<>2 THEN RETURN
  93. 500 PRINT "NOT CONVERGING IN " ; M ; "ITERATIONS"
  94. 501 PRINT : PRINT "SIGN COMB." ; : IF D1=1 THEN GOSUB 1300 : GOTO 503
  95. 502 FOR I=0 TO N : PRINT TAB(4*I+12) ; S(I) ; : NEXT I
  96. 503 PRINT : PRINT "EQU. SEQU." ; : IF D1=1 THEN GOSUB 1400 : RETURN
  97. 504 FOR I=0 TO N : PRINT TAB(4*I+12) ; A(I) ; : NEXT I : PRINT : PRINT :INPUT "TO CONTINUE,PRESS RETURN";CC$: RETURN
  98. 505 IF K2=1 THEN K2=0 : S1(I)=S2(I) : GOTO 515
  99. 510 PRINT F(I) ; TAB(25) ; X(I) : IF S1(I)*S2(I)<0 THEN K1=0 : PRINT  : PRINT "ITER" ; TAB(11) ; "P" ; TAB(18) ; "R" ; TAB(28) ; "ROOT" : PRINT : PRINT : RETURN
  100. 515 X(I)=X(I)+L : RETURN
  101. 600 T1=2^NN-1 : FOR T2=0 TO T1 : T5=T2 : FOR I2=0 TO N : I=A(I2) : X(I)=X2(I) : R(I)=R1(I2) : S1(I)=1 : P(I)=0 : NEXT I2
  102. 610 FOR I=N TO 0 STEP -1 : T3=T5/2 : T4=INT(T3) : IF T3-T4<.001 THEN S(I)=-1 : GOTO 630
  103. 620 S(I)=1
  104. 630 T5=T4 : NEXT I : GOSUB 300 : NEXT T2
  105. 640 PRINT : PRINT "ALL SIGN COMBINATIONS EXHAUSTED" : INPUT "RE-ARRANGE EQUATIONS? (Y/N)" ; T$ : IF LEFT$(T$,1)="N" THEN PRINT : PRINT "END OF PROGRAM" : END
  106. 650 RETURN
  107. 700 FOR SI=1 TO SS : PRINT "NR OF EQU IN SUB-SET" ; SI ; : INPUT N(SI) : NEXT SI
  108. 705 FOR I=1 TO SS : NN=4+N(I)+D0(I)+10*(I-1) : NEXT I : DIM C(NN) , ND(NN) , AA(NN)
  109. 710 PRINT "ENTER INITIAL VALUES" : II=0 : FOR SI=1 TO SS : IF D0(SI)=0 THEN GOTO 725
  110. 715 PRINT "FOR SUB-SET" ; SI
  111. 720 FOR I=0 TO D0(SI)-1 : PRINT "C(" ; I+II ; ")=" ; : INPUT C(I+II) : NEXT I
  112. 725 II=II+10 : NEXT SI : INPUT "H=" ; H : INPUT "T=" ; T : FOR I=1 TO 12 : B(I)=0 : NEXT I
  113. 730 IJ=0 : FOR I=1 TO SS : II=D0(I) : IF II=0 THEN GOTO 755
  114. 735 FOR J=4 TO II STEP -1
  115. 740 JJ=J-II : IF JJ=0 THEN GOTO 750
  116. 745 B(JJ+IJ)=1
  117. 750 NEXT J : IJ=IJ+3
  118. 755 NEXT I
  119. 760 II=0 : KT=0 : FOR J=1 TO SS : J0=N(J) : I0=D0(J) : FOR I=I0 TO J0+I0-1 : KT=KT+1 : ND(KT)=I+II : NEXT I
  120. 765 II=II+10 : NEXT J
  121. 770 II=0 : N=-1 : FOR J=1 TO SS : J0=N(J) : I0=D0(J) : FOR I=0 TO J0+I0-1 : N=N+1 : AA(N)=I+II : NEXT I
  122. 775 II=II+10 : NEXT J : RETURN
  123. 800 T=T+H : PRINT : II=0 : FOR J=1 TO SS : IF D0(J)=0 THEN GOTO 820
  124. 810 FOR I=0 TO D0(J)-1 : C(I+II)=X1(I+II) : PRINT "C(" ; I+II ; ")=" ; C(I+II) : NEXT I
  125. 820 II=II+10 : NEXT J : PRINT "H=" ; H : PRINT "T=" ; T : PRINT
  126. 830 IF C8=0 THEN GOSUB 1700 : IF LEFT$(T$,1)="Y" THEN INPUT "H=" ; H : GOTO 860
  127. 840 IF LEFT$(T$,1)<>"C" THEN C7=0 : GOTO 860
  128. 850 IF ABS(T-UL)<.000001 THEN C7=0 : C8=0 : GOSUB 1700 : IF LEFT$(T$,1)="Y" THEN INPUT "H=" ; H : RETURN
  129. 860 FOR II=0 TO N : I=A(II) : P(I)=0 : R(I)=R1(I) : X2(I)=X1(I) : NEXT II
  130. 870 RETURN
  131. 900 PRINT "X" ; I ; "=" ; X1(I) ; TAB(18) ; "F" ; I ; "=" ;
  132. 910 IF L1=N THEN J=I+1 : ON J GOSUB 10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42,43,44,45
  133. 920 PRINT TAB(25) : F(I) : RETURN
  134. 1000 PRINT "ENTER EQUATION SEQUENCE" : PRINT : PRINT "ORIGINAL F( )" , "NEW SEQUENCE"
  135. 1010 FOR J=1 TO KT : PRINT ND(J) ; TAB(23) ; : INPUT NX : NY=INT(NX/10)+1
  136. 1020 NQ=0 : FOR NZ=1 TO NY : NQ=NQ+D0(NZ) : NEXT NZ
  137. 1030 A(J+NQ-1)=NX : NEXT J : RETURN
  138. 1100 FOR J=1 TO KT : X(ND(J))=0 : X2(ND(J))=0 : R(ND(J))=0 : R1(ND(J))=0 : S(ND(J))=-1 : NEXT J : PRINT : PRINT "DEFAULT STARTING PARAMETERS ARE:   " : PRINT "X( )=0 , R( )=0 , SIGN( )=-1 " ; : INPUT "(Y/N)" ; T$ : IF LEFT$(T$,1)<>"N" THEN RETURN
  139. 1110 INPUT "CHANGE X( )? (Y/N)" ; T$ : IF LEFT$(T$,1)="N" THEN GOTO 1130
  140. 1120 FOR J=1 TO KT : PRINT "X(" ; ND(J) ; ")=" ; : INPUT X(ND(J)) : X2(ND(J))=X(ND(J)) : NEXT J
  141. 1130 INPUT "CHANGE R( )? (Y/N)" ; T$ : IF LEFT$(T$,1)="N" THEN GOTO 1150
  142. 1140 FOR J=1 TO KT : PRINT "R(" ; ND(J) ; ")=" ; : INPUT R(ND(J)) : R1(ND(J))=R(ND(J)) : NEXT J
  143. 1150 INPUT "CHANGE SIGNS? (Y/N)" ; T$ : IF LEFT$(T$,1)="N" THEN RETURN
  144. 1160 FOR J=1 TO KT : PRINT "SIGN F(" ; ND(J) ; ")=" ; : INPUT S(ND(J)) : NEXT J : RETURN
  145. 1200 FOR J0=1 TO KT : I0=ND(J0) : IF I0=I THEN PRINT TAB(2) ; K ; TAB(10) ; P(I) ; TAB(17) ; R(I) ; TAB(25) ; X1(I1)
  146. 1210 NEXT J0 : RETURN
  147. 1300 J1=-1 : FOR I=0 TO N : II=A(I) : FOR J0=1 TO KT : I0=ND(J0) : IF I0=II THEN J1=J1+1 : PRINT TAB(4*J1+12) ; S(II) ;
  148. 1310 NEXT J0 : NEXT I : PRINT : RETURN
  149. 1400 J1=-1 : FOR I=0 TO N : II=A(I) : FOR J0=1 TO KT : I0=ND(J0) : IF I0=II THEN J1=J1+1 : PRINT TAB(4*J1+12) ; A(I) ;
  150. 1410 NEXT J0 : NEXT I : PRINT : RETURN
  151. 1500 INPUT "RE-SET H? (Y/N)" ; T$ : IF LEFT$(T$,1)="Y" THEN INPUT "H=" ; H
  152. 1510 FOR II=0 TO N : I=A(II) : P(I)=0 : R(I)=R1(I) : X2(I)=X1(I) : NEXT II : RETURN
  153. 1600 INPUT "NEXT LIMIT OF T" ; UL : INPUT "NEW VALUE OF H" ; H : C7=1 : C8=1 : RETURN
  154. 1700 INPUT "CHANGE H? (Y/N/S/C/Q)" ; T$ : IF LEFT$(T$,1)="Q" THEN END
  155. 1710 RETURN
  156.  
  157.          MACINTOSH LISTING
  158.